Giga Pack/Giga Pack CD1.iso/strategy/yahwho/yahwho.pas

Pascal/Delphi Source File | 1993-06-27 | 67KB | 2,662 lines

{$B-,V-,X+} {These MUST be set!}
Program YahWho;

{ Developed in Borland Pascal 7.0 & Turbo Vision 2.0.

  Program Author: Keith Greer
                  68 Tamworth Rd.
                  Troy, OH 45373-1551

  Thanks to Tom & Guy Hunter for original logic & algorithms.

}
uses YahWho1,YahHelp,GpFrame,App,Dos,Objects,Drivers,Memory,Validate,
     Views,Menus,Dialogs,StdDlg,MsgBox,HelpFile,ColorSel;

type

  Scorestring = string[20];
  TDice       = array[1..5] of byte;
  ScoreType   = (Upper,Lower);
  TScore      = record
     TValue    : ScoreType;
     Value     : word;
  end;

  {TMyStatusLine}
  PMyStatusLine = ^TMyStatusLine;
  TMyStatusLine = object(TStatusLine)
    function Hint(AHelpCtx: Word): String; virtual;
  end;

  {TMyColorDialog}

  PMyColorDialog = ^TMyColorDialog;
  TMyColorDialog = object(TColorDialog)
    DPal : TPalette;
    constructor Init(APalette: TPalette;
                     DPalette: TPalette; AGroups: PColorGroup);
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PTopScore = ^TTopScore;
  TTopScore = object(TObject)
    Score : integer;
    Name,
    Date  : string[10];
    constructor Init(NewScore : integer; const NewName, NewDate : String);
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
  end;

  PScoreList = ^TScoreList;
  TScoreList = object(TSortedCollection)
    constructor Init(ALimit, ADelta: Integer);
    function Compare(Key1, Key2: Pointer): Integer; virtual;
    function KeyOf(Item: Pointer): Pointer; virtual;
  end;

  PTopScoreList = ^TTopScoreList;
  TTopScoreList = object(TScoreList)
    MinScore : integer;
    constructor Init(ALimit, ADelta: Integer);
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
    procedure Insert(Item: Pointer); virtual;
  end;

  PScoreListBox = ^TScoreListBox;
  TScoreListBox = object(TListBox)
    function GetText(Item: Integer; MaxLen: Integer): String; virtual;
  end;

  PYahWho = ^TYahWho;
  TYahWho = object(TApplication)
    constructor Init;
    destructor Done; virtual;
    constructor Load(var S : TStream);
    procedure About;
    procedure LoadDesktop(var S: TStream);
    procedure StoreDesktop(var S: TStream);
    procedure GetEvent(var Event: TEvent); virtual;
    function GetPalette: PPalette; virtual;
    function Valid(Command: Word): Boolean; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Idle; virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure OutOfMemory; virtual;
    procedure Awaken; virtual;
  end;

  PScoreItem = ^TScoreItem;
  TScoreItem = object(TView)
    constructor Init(Bounds : TRect; HKey : char; const Name : Scorestring);
    destructor Done; virtual;
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function GetPalette: PPalette; virtual;
    procedure Draw; virtual;
    function ValidScore(const D : TDice) : boolean; virtual;
  private
    HotKey    : char;
    ScoreName : PString;
    Score     : word;
    Lite      : boolean;
    Yahtzee,
    Scored     : boolean;
    TempScore  : word;
  end;

  PScoreBoard = ^TScoreBoard;
  TScoreBoard = object(TGroup)
    constructor Init(Bounds : TRect);
    procedure SizeLimits(var Min, Max: TPoint); virtual;
  end;

  PDiceSet = ^TDiceSet;
  TDiceSet = object(TGroup)
    constructor Init(Bounds : TRect);
    procedure SizeLimits(var Min, Max: TPoint); virtual;
  end;

  PDiceFrame = ^TDiceFrame;
  TDiceFrame = object(TGroupFrame)
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PScoreFrame = ^TScoreFrame;
  TScoreFrame = object(TGroupFrame)
    procedure Draw; virtual;
  end;

  PDie = ^TDie;
  TDie = object(TView)
    Value : byte;
    constructor Init(Bounds : TRect; HKey : char);
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
    function GetPalette : PPalette; virtual;
    procedure Draw; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  private
    HotKey : char;
    Selected   : boolean;
  end;

  PGameWindow = ^TGameWindow;
  TGameWindow = object(TWindow)
    Total     : word;
    RollCount : byte;
    Dice      : TDice;
    PlayerDone : boolean;
    constructor Init(Bounds :TRect; const Player : string);
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function Valid(Command: Word): Boolean; virtual;
    function RollOk : boolean;
  private
    ScoreBoard : PScoreBoard;
    DiceSet    : PDiceSet;
  end;

  PRollCounter = ^TRollCounter;
  TRollCounter = object(TView)
    constructor Init(Bounds : TRect);
    procedure Draw; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
  private
    Count : byte;
  end;

  POnes = ^TOnes;
  TOnes = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PTwos = ^TTwos;
  TTwos = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PThrees = ^TThrees;
  TThrees = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PFours = ^TFours;
  TFours = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PFives = ^TFives;
  TFives = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PSixes = ^TSixes;
  TSixes = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  P3Kind = ^T3Kind;
  T3Kind = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  P4Kind = ^T4Kind;
  T4Kind = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PFullHouse = ^TFullHouse;
  TFullHouse = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PSmStraight = ^TSmStraight;
  TSmStraight = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PLgStraight = ^TLgStraight;
  TLgStraight = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PYahtzee = ^TYahtzee;
  TYahtzee = object(TScoreItem)
    procedure HandleEvent(var Event: TEvent); virtual;
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PChance = ^TChance;
  TChance = object(TScoreItem)
    function ValidScore(const D : TDice) : boolean; virtual;
  end;

  PUpperTotal = ^TUpperTotal;
  TUpperTotal = object(TView)
    constructor Init(Bounds : TRect; const Name : Scorestring);
    destructor Done; virtual;
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function GetPalette: PPalette; virtual;
    procedure Draw; virtual;
  private
    ScoreName : PString;
    Total     : word;
    Bonus     : boolean;
  end;

  PUpperBonus = ^TUpperBonus;
  TUpperBonus = object(TView)
    constructor Init(Bounds : TRect; const Name : Scorestring);
    destructor Done; virtual;
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function GetPalette: PPalette; virtual;
    procedure Draw; virtual;
  private
    ScoreName : PString;
  end;

  PTotal = ^TTotal;
  TTotal = object(TView)
    constructor Init(Bounds : TRect; const Name : Scorestring);
    destructor Done; virtual;
    constructor Load(var S : TStream);
    procedure Store(var S : TStream); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function GetPalette: PPalette; virtual;
    procedure Draw; virtual;
  private
    ScoreName : PString;
    TopScore,BottomScore,
    Total  : word;
  end;

const

RTopScore : TStreamRec = (
  ObjType: 2500;
  VmtLink: Ofs(TypeOf(TTopScore)^);
  Load: @TTopScore.Load;
  Store: @TTopScore.Store);

RScoreList : TStreamRec = (
  ObjType: 2501;
  VmtLink: Ofs(TypeOf(TScoreList)^);
  Load: @TScoreList.Load;
  Store: @TScoreList.Store);

RTopScoreList : TStreamRec = (
  ObjType: 2502;
  VmtLink: Ofs(TypeOf(TTopScoreList)^);
  Load: @TTopScoreList.Load;
  Store: @TTopScoreList.Store);

RYahWho : TStreamRec = (
  ObjType: 2503;
  VmtLink: Ofs(TypeOf(TYahWho)^);
  Load: @TYahWho.Load;
  Store: @TYahWho.Store);

RScoreItem : TStreamRec = (
  ObjType: 2504;
  VmtLink: Ofs(TypeOf(TScoreItem)^);
  Load: @TScoreItem.Load;
  Store: @TScoreItem.Store);

RScoreBoard : TStreamRec = (
  ObjType: 2505;
  VmtLink: Ofs(TypeOf(TScoreBoard)^);
  Load: @TScoreBoard.Load;
  Store: @TScoreBoard.Store);

RDiceSet : TStreamRec = (
  ObjType: 2506;
  VmtLink: Ofs(TypeOf(TDiceSet)^);
  Load: @TDiceSet.Load;
  Store: @TDiceSet.Store);

RDiceFrame : TStreamRec = (
  ObjType: 2507;
  VmtLink: Ofs(TypeOf(TDiceFrame)^);
  Load: @TDiceFrame.Load;
  Store: @TDiceFrame.Store);

RDie : TStreamRec = (
  ObjType: 2508;
  VmtLink: Ofs(TypeOf(TDie)^);
  Load: @TDie.Load;
  Store: @TDie.Store);

RGameWindow : TStreamRec = (
  ObjType: 2509;
  VmtLink: Ofs(TypeOf(TGameWindow)^);
  Load: @TGameWindow.Load;
  Store: @TGameWindow.Store);

RUpperBonus : TStreamRec = (
  ObjType: 2510;
  VmtLink: Ofs(TypeOf(TUpperBonus)^);
  Load: @TUpperBonus.Load;
  Store: @TUpperBonus.Store);

RTotal : TStreamRec = (
  ObjType: 2511;
  VmtLink: Ofs(TypeOf(TTotal)^);
  Load: @TTotal.Load;
  Store: @TTotal.Store);

RScoreFrame : TStreamRec = (
  ObjType: 2512;
  VmtLink: Ofs(TypeOf(TScoreFrame)^);
  Load: @TScoreFrame.Load;
  Store: @TScoreFrame.Store);

ROnes : TStreamRec = (
  ObjType: 2513;
  VmtLink: Ofs(TypeOf(TOnes)^);
  Load: @TOnes.Load;
  Store: @TOnes.Store);

RTwos : TStreamRec = (
  ObjType: 2514;
  VmtLink: Ofs(TypeOf(TTwos)^);
  Load: @TTwos.Load;
  Store: @TTwos.Store);

RThrees : TStreamRec = (
  ObjType: 2515;
  VmtLink: Ofs(TypeOf(TThrees)^);
  Load: @TThrees.Load;
  Store: @TThrees.Store);

RFours : TStreamRec = (
  ObjType: 2516;
  VmtLink: Ofs(TypeOf(TFours)^);
  Load: @TFours.Load;
  Store: @TFours.Store);

RFives : TStreamRec = (
  ObjType: 2517;
  VmtLink: Ofs(TypeOf(TFives)^);
  Load: @TFives.Load;
  Store: @TFives.Store);

RSixes : TStreamRec = (
  ObjType: 2518;
  VmtLink: Ofs(TypeOf(TSixes)^);
  Load: @TSixes.Load;
  Store: @TSixes.Store);

R3Kind : TStreamRec = (
  ObjType: 2519;
  VmtLink: Ofs(TypeOf(T3Kind)^);
  Load: @T3Kind.Load;
  Store: @T3Kind.Store);

R4Kind : TStreamRec = (
  ObjType: 2520;
  VmtLink: Ofs(TypeOf(T4Kind)^);
  Load: @T4Kind.Load;
  Store: @T4Kind.Store);

RFullHouse : TStreamRec = (
  ObjType: 2521;
  VmtLink: Ofs(TypeOf(TFullHouse)^);
  Load: @TFullHouse.Load;
  Store: @TFullHouse.Store);

RSmStraight : TStreamRec = (
  ObjType: 2522;
  VmtLink: Ofs(TypeOf(TSmStraight)^);
  Load: @TSmStraight.Load;
  Store: @TSmStraight.Store);

RLgStraight : TStreamRec = (
  ObjType: 2523;
  VmtLink: Ofs(TypeOf(TLgStraight)^);
  Load: @TLgStraight.Load;
  Store: @TLgStraight.Store);

RYahtzee : TStreamRec = (
  ObjType: 2524;
  VmtLink: Ofs(TypeOf(TYahtzee)^);
  Load: @TYahtzee.Load;
  Store: @TYahtzee.Store);

RChance : TStreamRec = (
  ObjType: 2525;
  VmtLink: Ofs(TypeOf(TChance)^);
  Load: @TChance.Load;
  Store: @TChance.Store);

RUpperTotal : TStreamRec = (
  ObjType: 2526;
  VmtLink: Ofs(TypeOf(TUpperTotal)^);
  Load: @TUpperTotal.Load;
  Store: @TUpperTotal.Store);

RRollCounter : TStreamRec = (
  ObjType: 2527;
  VmtLink: Ofs(TypeOf(TRollCounter)^);
  Load: @TRollCounter.Load;
  Store: @TRollCounter.Store);

procedure RegisterGame;
begin
  RegisterType(RTopScore);
  RegisterType(RScoreList);
  RegisterType(RTopScoreList);
  RegisterType(RYahWho);
  RegisterType(RScoreItem);
  RegisterType(RScoreBoard);
  RegisterType(RDiceSet);
  RegisterType(RDiceFrame);
  RegisterType(RDie);
  RegisterType(RGameWindow);
  RegisterType(RUpperBonus);
  RegisterType(RTotal);
  RegisterType(RScoreFrame);
  RegisterType(ROnes);
  RegisterType(RTwos);
  RegisterType(RThrees);
  RegisterType(RFours);
  RegisterType(RFives);
  RegisterType(RSixes);
  RegisterType(R3Kind);
  RegisterType(R4Kind);
  RegisterType(RFullHouse);
  RegisterType(RSmStraight);
  RegisterType(RLgStraight);
  RegisterType(RYahtzee);
  RegisterType(RChance);
  RegisterType(RUpperTotal);
  RegisterType(RRollCounter);
end;

{ ************************** Method definitions ************************* }

{***** TMyColorDialog *****}

constructor TMyColorDialog.Init;
var
  R : TRect;
begin
  TColorDialog.Init(APalette, AGroups);
  DPal := DPalette;
  R.Assign(25, 15, 34, 17);
  Insert(New(PButton, Init(R, '~R~eset', cmRstColors, bfNormal)));
end;

procedure TMyColorDialog.HandleEvent;
begin
  if (Event.What = evCommand) and (Event.Command = cmRstColors) then
  begin
    SetData(DPal);
    ClearEvent(Event);
  end else
  TColorDialog.HandleEvent(Event);
end;

{ ********** TScoreListBox ********** }

{This function governs the text in the Hall of Fame list box}

function TScoreListBox.GetText(Item: Integer; MaxLen: Integer): String;
var
  S : string[3];
  N : string[11];
  R : string;
begin
  if List=nil then GetText:='' else
  begin
    with PTopScore(List^.At(Item))^ do
    begin
      Str(Score:3,S);
      N := Name;
      while Length(N) < 11 do N := N+' ';
      R := Date+' '+N+S;
      if Length(R) > MaxLen then R[0]:= Chr(MaxLen);
      GetText := R;
    end;
  end;
end;

{ ********** TScoreList ********** }


constructor TScoreList.Init;
begin
  Inherited Init(ALimit, ADelta);
  Duplicates := True;
end;

function TScoreList.Compare; {Decending score order}
begin
  if integer(Key1^) > integer(Key2^) then Compare := -1 else
  if integer(Key1^) = integer(Key2^) then Compare :=  0 else
  Compare :=  1;
end;

function TScoreList.KeyOf;
begin
  KeyOf := @PTopScore(Item)^.Score;
end;

{ ********** TTopScore ********** }

constructor TTopScore.Init;
begin
  Inherited Init;
  Score := NewScore;
  Name := NewName;
  Date := NewDate;
end;

constructor TTopScore.Load;
begin
  with S do
  begin
    Read(Score, SizeOf(Score));
    Read(Name, SizeOf(Name));
    Read(Date, SizeOf(Date));
  end;
end;

procedure TTopScore.Store;
begin
  with S do
  begin
    Write(Score, SizeOf(Score));
    Write(Name, SizeOf(Name));
    Write(Date, SizeOf(Date));
  end;
end;

{ **********  TTopScoreList ********** }

constructor TTopScoreList.Init;
begin
  Inherited Init(ALimit,ADelta);
  MinScore := 0;
end;

constructor TTopScoreList.Load;
begin
  Inherited Load(S);
  S.Read(MinScore, SizeOf(MinScore));
end;

procedure TTopScoreList.Store;
begin
  Inherited Store(S);
  S.Write(MinScore, SizeOf(MinScore));
end;

procedure TTopScoreList.Insert;
begin
  with PTopScore(Item)^ do if Score > MinScore then
  begin
    if Count=10 then AtDelete(9);
    Inherited Insert(Item);
    if Count > 0 then MinScore := PTopScore(At(Count-1))^.Score
    else MinScore := 0;
  end;
end;

{ **********  TScoreBoard ********** }

constructor TScoreBoard.Init;
var
  R : TRect;
begin
  Inherited Init(Bounds);
  Options := Options or (ofSelectable + ofFirstClick);
  HelpCtx := hcScore;
  GetExtent(R);
  Insert(New(PScoreFrame, Init(R)));
  R.Assign(2,1,25,2);
  Insert(New(POnes, Init(R,'1','Ones .........')));
  R.Move(0,1);
  Insert(New(PTwos, Init(R,'2','Twos .........')));
  R.Move(0,1);
  Insert(New(PThrees, Init(R,'3','Threes .......')));
  R.Move(0,1);
  Insert(New(PFours, Init(R,'4','Fours ........')));
  R.Move(0,1);
  Insert(New(PFives, Init(R,'5','Fives ........')));
  R.Move(0,1);
  Insert(New(PSixes, Init(R,'6','Sixes ........')));
  R.Move(0,1);
  Insert(New(PUpperBonus, Init(R,'Upper Bonus ....    35')));
  R.Move(0,1);
  Insert(New(PUpperTotal, Init(R,'Upper Total ....')));
  R.Move(0,2);
  Insert(New(P3Kind, Init(R,'A','3 of a Kind ..')));
  R.Move(0,1);
  Insert(New(P4Kind, Init(R,'B','4 of a Kind ..')));
  R.Move(0,1);
  Insert(New(PFullHouse, Init(R,'C','Full House ...')));
  R.Move(0,1);
  Insert(New(PSmStraight, Init(R,'D','Sm Straight ..')));
  R.Move(0,1);
  Insert(New(PLgStraight, Init(R,'E','Lg Straight ..')));
  R.Move(0,1);
  Insert(New(PYahtzee, Init(R,'F','YAHTZEE ......')));
  R.Move(0,1);
  Insert(New(PChance, Init(R,'G','Chance .......')));
  R.Move(0,2);
  Insert(New(PTotal, Init(R,'Total ....')));
  SetState(sfDisabled,True);
end;

procedure TScoreBoard.SizeLimits(var Min, Max: TPoint);
begin
  Min := ScoreBoardSize;
  Max := Min;
end;

{ **********  TDiceFrame ********** }

procedure TDiceFrame.HandleEvent;
var
  MouseHere : TPoint;
begin
  {A double click on the dice frame selects them all. A single click
   deselects them.}

  if (Event.What=evMouseDown) then
  begin
    MakeLocal(Event.Where,MouseHere);
    with MouseHere do if (X in [0,Size.X-1]) or (Y in [0,Size.Y-1]) then
    begin
      if Event.Double then Message(Owner,evCommand,cmSelectAll,nil)
      else Message(Owner,evCommand,cmDeSelectAll,nil);
    end;
    ClearEvent(Event);
  end else Inherited HandleEvent(Event);
end;


{ **********  TScoreFrame ********** }

procedure TScoreFrame.Draw;
begin
  Inherited Draw;
  WriteStr(19,17,'────── ',4);   {Underscore the Total}
end;

{ **********  TScoreItem ********** }

constructor TScoreItem.Init;
begin
  Inherited Init(Bounds);
  Options := Options or
    (ofScore + ofPreprocess + ofSelectable + ofFirstClick);
  EventMask := EventMask or evBroadcast;
  HotKey := HKey;
  ScoreName := NewStr(Name);
  Score := 0;
  Lite := False;
  Scored := False;
  Yahtzee := False;
end;

destructor TScoreItem.Done;
begin
  DisposeStr(ScoreName);
  Inherited Done;
end;

constructor TScoreItem.Load;
begin
  Inherited Load(S);
  with S do
  begin
    Read(HotKey, SizeOf(HotKey));
    ScoreName := ReadStr;
    Read(Score, SizeOf(Score));
    Read(Lite, SizeOf(Lite));
    Read(Yahtzee, SizeOf(Yahtzee));
    Read(Scored, SizeOf(Scored));
    Read(TempScore, SizeOf(TempScore));
  end;
end;

procedure TScoreItem.Store;
begin
  Inherited Store(S);
  with S do
  begin
    Write(HotKey, SizeOf(HotKey));
    WriteStr(ScoreName);
    Write(Score, SizeOf(Score));
    Write(Lite, SizeOf(Lite));
    Write(Yahtzee, SizeOf(Yahtzee));
    Write(Scored, SizeOf(Scored));
    Write(TempScore, SizeOf(TempScore));
  end;
end;

procedure TScoreItem.HandleEvent(var Event : TEvent);
var
  N : TScore;

begin
  Inherited HandleEvent(Event);
  if (Event.What=evBroadcast) then
  case Event.Command of
    cmRollDone:
      begin
        Lite := (ValidScore(TDice(Event.InfoPtr^))) and not Scored;
        DrawView;
      end;
    cmScored:
      begin
        Lite := False;
        DrawView;
      end;
  end {case}
  else if ((Event.What=evMouseDown) or
      ((Event.What=evKeyDown) and (Upcase(Event.CharCode)=HotKey))) then
  begin
    if not Scored then
    begin
      if (TempScore=0) and (MessageBox(^C'Take a zero?', nil,
          mfConfirmation+mfYesButton+mfNoButton) = cmNo) then exit;
      Scored :=True;
      Score := TempScore;
      N.Value := Score;
      if HotKey in ['1'..'6'] then N.TValue:=Upper else N.TValue:=Lower;
      DrawView;
      Tune(Bleep);
      if Yahtzee then Message(Desktop,evBroadcast,cmYahtzee,@Self);
      Message(Desktop,evBroadcast,cmScored,@N);
    end else Tune(Bells);
    ClearEvent(Event);
  end;
end;

function TScoreItem.GetPalette : PPalette;
const
  C = #4#5;
  P : string[Length(C)] = C;
begin
  GetPalette := @P;
end;

procedure TScoreItem.Draw;
var
  S : string[3];
  C : integer;

begin
  if Lite then C := 2 else C := 1;
  WriteChar(0,0,' ',C,23);
  WriteChar(1,0,HotKey,2,1);
  WriteStr(3,0,ScoreName^,C);
  if not Scored then WriteStr(21,0,'-',C) else
  begin
    Str(Score:3, S);
    WriteStr(20,0,S,C);
  end;
  if Lite and ShowMarkers then WriteChar(0,0,#175,1 ,1);
end;

function TScoreItem.ValidScore(const D : TDice) : boolean;
begin
  Abstract;
end;

function TOnes.ValidScore(const D : TDice) : boolean;
var
  i : byte;
begin
  TempScore := 0;
  for i:=1 to 5 do if D[i]=1 then Inc(TempScore);
  Yahtzee := TempScore=5;
  ValidScore := TempScore>0;
end;

function TTwos.ValidScore(const D : TDice) : boolean;
var
  i : byte;
begin
  TempScore := 0;
  for i:=1 to 5 do if D[i]=2 then Inc(TempScore,2);
  Yahtzee := TempScore=10;
  ValidScore := TempScore>0;
end;


function TThrees.ValidScore(const D : TDice) : boolean;
var
  i : byte;
begin
  TempScore := 0;
  for i:=1 to 5 do if D[i]=3 then Inc(TempScore,3);
  Yahtzee := TempScore=15;
  ValidScore := TempScore>0;
end;


function TFours.ValidScore(const D : TDice) : boolean;
var
  i : byte;
begin
  TempScore := 0;
  for i:=1 to 5 do if D[i]=4 then Inc(TempScore,4);
  Yahtzee := TempScore=20;
  ValidScore := TempScore>0;
end;


function TFives.ValidScore(const D : TDice) : boolean;
var
  i : byte;
begin
  TempScore := 0;
  for i:=1 to 5 do if D[i]=5 then Inc(TempScore,5);
  Yahtzee := TempScore=25;
  ValidScore := TempScore>0;
end;


function TSixes.ValidScore(const D : TDice) : boolean;
var
  i : byte;
begin
  TempScore := 0;
  for i:=1 to 5 do if D[i]=6 then Inc(TempScore,6);
  Yahtzee := TempScore=30;
  ValidScore := TempScore>0;
end;


function T3Kind.ValidScore(const D : TDice) : boolean;
var
  i,j : byte;
  n : array[1..6] of byte;
begin
  FillChar(n,SizeOf(n),0);
  for i:=1 to 6 do
    for j:=1 to 5 do if D[j]=i then Inc(n[i]);
  j:=0; TempScore := 0;
  for i:=1 to 6 do if n[i]>j then j:=n[i];
  Yahtzee := j=5;
  if j>=3 then
  begin
    ValidScore := True;
    for i:=1 to 5 do Inc(TempScore,D[i]);
  end
  else ValidScore := False;
end;

function T4Kind.ValidScore(const D : TDice) : boolean;
var
  i,j : byte;
  n : array[1..6] of byte;
begin
  FillChar(n,SizeOf(n),0);
  for i:=1 to 6 do
    for j:=1 to 5 do if D[j]=i then Inc(n[i]);
  j:=0; TempScore := 0;
  for i:=1 to 6 do if n[i]>j then j:=n[i];
  Yahtzee := j=5;
  if j>=4 then
  begin
    ValidScore:=True;
    for i:=1 to 5 do Inc(TempScore,D[i]);
  end
  else ValidScore:=False;
end;

function TFullHouse.ValidScore(const D : TDice) : boolean;
var
  i,j : byte;
  n : array[1..6] of byte;
  Ok : boolean;
begin
  FillChar(n,SizeOf(n),0);
  for i:=1 to 6 do
    for j:=1 to 5 do if D[j]=i then Inc(n[i]);

  {n now contains the count of how many times each number (1..6) appears
   in the dice roll. For example, if n[2]=3, then 2 appears on 3 dice.
   In order to have a valid Full House, any given number must either
   not appear at all, appear twice, or three times. This may be a brute
   force approach. I'm sure there are more elegant ways, but this is
   foolproof, and it doesn't take long.}

  Ok:=True; i:=1;
  while Ok and (i<=6) do
  begin
    Ok := n[i] in [0,2,3]; Inc(i);
  end;
  if Ok then
  begin
    ValidScore := True; TempScore:=25;
  end else
  begin
    ValidScore := False; TempScore:=0;
  end;
end;

function TSmStraight.ValidScore(const D : TDice) : boolean;
var
  i : byte;
  M : set of 1..6;
  Ok : boolean;
begin

  {Sets are sweet! Too bad, C++}

  M:=[];
  for i:=1 to 5 do Include(M,D[i]);
  Ok := (M*[1..4]=[1..4]) or
        (M*[2..5]=[2..5]) or
        (M*[3..6]=[3..6]);
  if Ok then
  begin
    ValidScore:=True; TempScore:=30;
  end else
  begin
    ValidScore:=False; TempScore:=0;
  end;
end;

function TLgStraight.ValidScore(const D : TDice) : boolean;
var
  i,c : byte;
  M : set of 1..6;
  Ok : boolean;
begin
  M:=[];
  for i:=1 to 5 do Include(M,D[i]);
  Ok := (M=[1..5]) or (M=[2..6]);
  if Ok then
  begin
    ValidScore:=True; TempScore:=40;
  end else
  begin
    ValidScore:=False; TempScore:=0;
  end;
end;

procedure TYahtzee.HandleEvent(var Event: TEvent);
var
  N : TScore;
begin
  Inherited HandleEvent(Event);
  with Event do
  if (What=evBroadcast) and (Command=cmYahtzee) and (InfoPtr<>@Self) then
    if Score > 0 then
    begin
      Inc(Score,100); DrawView; {Award Bonus Yahtzee }
      N.TValue := Lower; N.Value := 100;
      Message(Owner,evBroadcast,cmScored,@N);
    end else ClearEvent(Event);
end;


function TYahtzee.ValidScore(const D : TDice) : boolean;
var
  i : byte;
begin
  i:=1;

  while (i<5) and (D[i]=D[i+1]) do Inc(i);

  if i=5 then
  begin
    ValidScore:=True; TempScore:=50;
    Yahtzee := True;
  end else
  begin
    ValidScore:=False; TempScore:=0;
    Yahtzee:=False;
  end;
end;

function TChance.ValidScore(const D : TDice) : boolean;
var
  i : byte;
begin
  ValidScore := True;
  TempScore:=0;
  for i:=1 to 5 do Inc(TempScore,D[i]);
  i:=1;
  while (i<5) and (D[i]=D[i+1]) do Inc(i);
  Yahtzee:=i=5;
end;

{ **********  TUpperBonus ********** }

constructor TUpperBonus.Init;
begin
  Inherited Init(Bounds);
  Options := Options or ofPreprocess;
  EventMask := EventMask or evBroadcast;
  ScoreName := NewStr(Name);
  Hide;
end;

destructor TUpperBonus.Done;
begin
  DisposeStr(ScoreName);
  Inherited Done;
end;

constructor TUpperBonus.Load;
begin
  Inherited Load(S);
  ScoreName := S.ReadStr;
end;

procedure TUpperBonus.Store;
begin
  Inherited Store(S);
  S.WriteStr(ScoreName);
end;


procedure TUpperBonus.HandleEvent(var Event : TEvent);
begin
  Inherited HandleEvent(Event);
  if (Event.What=evBroadcast) and (Event.Command=cmShowBonus) then
  begin
    Show;
    ClearEvent(Event);
  end;
end;

function TUpperBonus.GetPalette : PPalette;
const
  C = #4#5;
  P : string[Length(C)] = C;
begin
  GetPalette := @P;
end;

procedure TUpperBonus.Draw;

begin
  WriteChar(0,0,' ',1,23);
  WriteStr(1,0,ScoreName^,1);
end;

{ **********  TUpperTotal ********** }

constructor TUpperTotal.Init;
begin
  Inherited Init(Bounds);
  Options := Options or ofPreprocess;
  EventMask := EventMask or evBroadcast;
  ScoreName := NewStr(Name);
  Total := 0;
  Bonus := False;
end;

destructor TUpperTotal.Done;
begin
  DisposeStr(ScoreName);
  Inherited Done;
end;

constructor TUpperTotal.Load;
begin
  Inherited Load(S);
  with S do
  begin
    ScoreName := ReadStr;
    Read(Total, SizeOf(Total));
    Read(Bonus, SizeOf(Bonus));
  end;
end;

procedure TUpperTotal.Store;
begin
  Inherited Store(S);
  with S do
  begin
    WriteStr(ScoreName);
    Write(Total, SizeOf(Total));
    Write(Bonus, SizeOf(Bonus));
  end;
end;


procedure TUpperTotal.HandleEvent(var Event : TEvent);
begin
  Inherited HandleEvent(Event);
  if (Event.What=evBroadcast) and (Event.Command=cmScored) then
  begin
    with TScore(Event.InfoPtr^) do
      if TValue=Upper then Inc(Total,Value);
    if (Total >= 63) and not Bonus then
    begin
      Bonus := True;
      Inc(Total,35);
      Message(Owner,evBroadcast,cmShowBonus,nil);
    end;
    DrawView;
  end;
end;

function TUpperTotal.GetPalette : PPalette;
const
  C = #4#5;
  P : string[Length(C)] = C;
begin
  GetPalette := @P;
end;

procedure TUpperTotal.Draw;
var
  S : string[3];

begin
  WriteChar(0,0,' ',1,23);
  WriteStr(1,0,ScoreName^,1);
  Str(Total:3, S);
  WriteStr(20,0,S,1);
end;

{ **********  TTotal ********** }

constructor TTotal.Init;
begin
  Inherited Init(Bounds);
  Options := Options or ofPreprocess;
  EventMask := EventMask or evBroadcast;
  ScoreName := NewStr(Name);
  Total := 0; TopScore := 0; BottomScore := 0;
end;

destructor TTotal.Done;
begin
  DisposeStr(ScoreName);
  Inherited Done;
end;

constructor TTotal.Load;
begin
  Inherited Load(S);
  with S do
  begin
    ScoreName := ReadStr;
    Read(TopScore, SizeOf(TopScore));
    Read(BottomScore, SizeOf(BottomScore));
    Read(Total, SizeOf(Total));
  end;
end;

procedure TTotal.Store;
begin
  Inherited Store(S);
  with S do
  begin
    WriteStr(ScoreName);
    Write(TopScore, SizeOf(TopScore));
    Write(BottomScore, SizeOf(BottomScore));
    Write(Total, SizeOf(Total));
  end;
end;

procedure TTotal.HandleEvent(var Event : TEvent);
begin
  Inherited HandleEvent(Event);
  if (Event.What=evBroadcast) and (Event.Command=cmScored) then
  begin
    with TScore(Event.InfoPtr^) do
      if TValue=Upper then Inc(TopScore,Value) else Inc(BottomScore,Value);
    Total := TopScore + BottomScore;
    if TopScore > 63 then Inc(Total,35);
    DrawView;
    Message(Desktop,evBroadcast,cmNewTotal,@Total);
  end;
end;

function TTotal.GetPalette : PPalette;
const
  C = #4#5;
  P : string[Length(C)] = C;
begin
  GetPalette := @P;
end;

procedure TTotal.Draw;
var
  S : string[3];

begin
  WriteChar(0,0,' ',1,23);
  WriteStr(7,0,ScoreName^,1);
  Str(Total:3, S);
  WriteStr(20,0,S,1);
end;

{ **********  TDiceSet ********** }

constructor TDiceSet.Init;
var
  R : TRect;
begin
  Inherited Init(Bounds);
  Options := Options or (ofSelectable + ofFirstClick);
  GrowMode := gfGrowLoX+gfGrowHiX;
  HelpCtx := hcRoll;
  GetExtent(R);
  Insert(New(PDiceFrame, Init(R)));
  R.Assign(3,0,11,1);
  Insert(New(PRollCounter, Init(R)));
  R.Assign(3,1,12,4);
  Insert(New(PDie, Init(R, '1')));
  R.Move(0,4);
  Insert(New(PDie, Init(R, '2')));
  R.Move(0,4);
  Insert(New(PDie, Init(R, '3')));
  R.Move(0,4);
  Insert(New(PDie, Init(R, '4')));
  R.Move(0,4);
  Insert(New(PDie, Init(R, '5')));
end;

procedure TDiceSet.SizeLimits(var Min, Max: TPoint);
begin
  Min := DiceSetSize;
  Max := Min;
end;

{ **********  TDie ********** }

constructor TDie.Init;
begin
  Inherited Init(Bounds);
  EventMask := EventMask or evBroadcast;
  HotKey := HKey;
  Options := Options or (ofDie + ofPreProcess + ofSelectable + ofFirstClick);
  Value := 1 + Random(6);
  Selected := False;
  Hide;
end;

constructor TDie.Load;
begin
  Inherited Load(S);
  with S do
  begin
    Read(Value, SizeOf(Value));
    Read(HotKey, SizeOf(HotKey));
    Read(Selected, SizeOf(Selected));
  end;
end;

procedure TDie.Store;
begin
  Inherited Store(S);
  with S do
  begin
    Write(Value, SizeOf(Value));
    Write(HotKey, SizeOf(HotKey));
    Write(Selected, SizeOf(Selected));
  end;
end;

procedure TDie.HandleEvent(var Event: TEvent);
begin
  Inherited HandleEvent(Event);

  if Event.What = evCommand then
  case Event.Command of
    cmRollDie     : if Selected then
                    begin
                      Selected := False;
                      Value := Random(6) + 1;
                      DrawView;
                    end;
    cmSelectAll   : begin
                      Selected := True; DrawView;
                    end;
    cmDeSelectAll : begin
                      Selected := False; DrawView;
                    end;
  end {case}
  else if ((Event.What = evMouseDown) or
            ((Event.What=evKeyDown) and (Event.CharCode=HotKey))) then
  begin
    Selected := not Selected;
    DrawView;
    ClearEvent(Event);
  end
  else if (Event.What = evBroadcast) and
    (Event.Command = cmScored) then  Hide;
end;

function TDie.GetPalette : PPalette;
const
  CDie = #6#7#5#4;
  P : string[Length(CDie)] = CDie;
begin
  GetPalette := @P;
end;

procedure TDie.Draw;
const
  Dot =#254;
var
  C : byte;

procedure Draw1;
begin
  WriteStr(0,0,'       ',C);
  WriteStr(0,1,'   '+Dot+'   ',C);  {Concatenate to save code, speed}
  WriteStr(0,2,'       ',C);
end;

procedure Draw2;
begin
  WriteStr(0,0,' '+Dot+'     ',C);
  WriteStr(0,1,'       ',C);
  WriteStr(0,2,'     '+Dot+' ',C);
end;

procedure Draw3;
begin
  WriteStr(0,0,' '+Dot+'     ',C);
  WriteStr(0,1,'   '+Dot+'   ',C);
  WriteStr(0,2,'     '+Dot+' ',C);
end;

procedure Draw4;
begin
  WriteStr(0,0,' '+Dot+'   '+Dot+' ',C);
  WriteStr(0,1,'       ',C);
  WriteStr(0,2,' '+Dot+'   '+Dot+' ',C);
end;

procedure Draw5;
begin
  WriteStr(0,0,' '+Dot+'   '+Dot+' ',C);
  WriteStr(0,1,'   '+Dot+'   ',C);
  WriteStr(0,2,' '+Dot+'   '+Dot+' ',C);
end;

procedure Draw6;
begin
  WriteStr(0,0,' '+Dot+' '+Dot+' '+Dot+' ',C);
  WriteStr(0,1,'       ',C);
  WriteStr(0,2,' '+Dot+' '+Dot+' '+Dot+' ',C);
end;

var
  B : TDrawBuffer;

begin
  if Selected then C := 2 else C := 1;
  MoveStr(B, '         ', GetColor(4 ));
  WriteLine(0, 0, Size.X, Size.Y, B);

  case Value of
    1 : Draw1;
    2 : Draw2;
    3 : Draw3;
    4 : Draw4;
    5 : Draw5;
    6 : Draw6;
  end; {case}
  WriteChar(8,0,HotKey,3,1);
  if Selected and ShowMarkers then WriteChar(8,1,#174,4,1);
end;

{ ********** TRollCounter ********** }

constructor TRollCounter.Init;
begin
  Inherited Init(Bounds);
  EventMask := EventMask or evBroadcast;
  Count:=1;
  Hide;
end;

constructor TRollCounter.Load;
begin
  Inherited Load(S);
  S.Read(Count, SizeOf(Count));
end;

procedure TRollCounter.Store;
begin
  Inherited Store(S);
  S.Write(Count,SizeOf(Count));
end;

procedure TRollCounter.Draw;
begin
  if Owner^.GetState(sfFocused) then
    WriteStr(0,0,' Roll '+Chr(Count+48)+' ',2)
  else WriteStr(0,0,' Roll '+Chr(Count+48)+' ',1);
end;

procedure TRollCounter.HandleEvent(var Event: TEvent);
begin
  Inherited HandleEvent(Event);
  if Event.What = evBroadcast then
  case Event.Command of
    cmRollDone:
      begin
        Count := byte(Event.InfoPtr^);
        DrawView;
        ClearEvent(Event);
      end;
    cmReceivedFocus,cmReleasedFocus: DrawView;
    cmScored:
      begin
        Hide;
        Count := 1;
      end;
  end;
end;


{ **********  TGameWindow ********** }

constructor TGameWindow.Init;
const
  ScoreBoardX = 5;
  ScoreBoardY = 1;
  DiceSetX = 60;
  DiceSetY = 1;
var
  R :TRect;
begin
  Randomize;
  Inherited Init(Bounds,Player,WinNumber);
  Options := Options or (ofTileable+ofGameWindow);
  EventMask := EventMask or evBroadcast;

  R.Assign(ScoreBoardX,ScoreBoardY,
           ScoreBoardX+ScoreBoardSize.X,
           ScoreBoardY+ScoreBoardSize.Y);
  ScoreBoard := New(PScoreBoard, Init(R));
  Insert(ScoreBoard);

  R.Assign(DiceSetX,DiceSetY,
           DiceSetX+DiceSetSize.X,
           DiceSetY+DiceSetSize.Y);
  DiceSet := New(PDiceSet, Init(R));
  Insert(DiceSet);
  RollCount := 0;
  PlayerDone := False;
end;

constructor TGameWindow.Load;
begin
  Inherited Load(S);
  with S do
  begin
    Read(Total, SizeOf(Total));
    Read(RollCount, SizeOf(RollCount));
    Read(Dice, SizeOf(Dice));
    Read(PlayerDone, SizeOf(PlayerDone));
    GetSubViewPtr(S, ScoreBoard);
    GetSubViewPtr(S, DiceSet);
  end;
end;

procedure TGameWindow.Store;
begin
  Inherited Store(S);
  with S do
  begin
    Write(Total, SizeOf(Total));
    Write(RollCount, SizeOf(RollCount));
    Write(Dice, SizeOf(Dice));
    Write(PlayerDone, SizeOf(PlayerDone));
    PutSubViewPtr(S, ScoreBoard);
    PutSubViewPtr(S, DiceSet);
  end;
end;

function TGameWindow.Valid(Command: Word): Boolean;
begin
  if (Command in [cmClose,cmQuit]) and not PlayerDone then
      Valid := MessageBox(^C'Are you sure you want to quit?', nil ,
               mfConfirmation+mfYesButton+mfNoButton)=cmYes
    else Valid:=True;
end;

procedure TGameWindow.HandleEvent(var Event: TEvent);
const
  Msg = 'Y  A  H  T  Z  E  E  !!!';

var
  i : byte;
  D : PDialog;
  R : TRect;
  B : PView;

  procedure GetDice(D : PDie); far;
  begin
    with D^ do if Options and ofDie <> 0 then Dice[i] := Value;
    Inc(i);
  end;

  procedure ShowDice(D : PView); far;
  begin
    with D^ do
    begin
      Show;
      if Options and ofDie <> 0 then PDie(D)^.Selected := True;
    end;
  end;

  function Unscored(S : PScoreItem) : boolean; far;
  begin
    with S^ do
      Unscored := (Options and ofScore <> 0) and not Scored;
  end;

begin

  if (Event.What=evCommand) and (Event.Command=cmRollDie)
        and (RollCount=0) then
  begin
    DiceSet^.Select;
    DiceSet^.ForEach(@ShowDice);
  end;

  Inherited HandleEvent(Event);

  if (Event.What=evCommand) and (Event.Command=cmRollDie) then
  begin
    Tune(DiceRoll);
    ScoreBoard^.SetState(sfDisabled,False);
    Inc(RollCount);
    i:=1;
    DiceSet^.ForEach(@GetDice);
    Message(ScoreBoard,evBroadcast,cmRollDone,@Dice);
    Message(DiceSet,evBroadcast,cmRollDone,@RollCount);
    if RollCount=3 then
    begin
      DiceSet^.SetState(sfDisabled,True);
      ScoreBoard^.Select;
    end;
    ClearEvent(Event);
  end else
  if (Event.What=evBroadcast) then
  case Event.Command of
    cmYahtzee:
      begin
        R.Assign(0,0,35,8);
        Tune(Yahtzee);

        D := New(PDialog, Init(R, 'Congratulations!'));
        with D^ do
        begin
          Options := Options or ofCentered;
          R.Assign(0,0,Length(Msg),1);
          B := New(PStaticText, Init(R,Msg));
          with B^ do Options := Options or ofCentered;
          Insert(B);

          GetExtent(R);
          R.Assign(0,R.B.Y-3,8,R.B.Y-1);
          B := New(PButton, Init(R, 'O~K~', cmOk, bfDefault));
          with B^ do Options := Options or ofCenterX;
          Insert(B);

          Application^.ExecuteDialog(D,nil);
        end;

        ClearEvent(Event);
      end;
    cmNewTotal:
      begin
        Total:=word(Event.InfoPtr^);
        ClearEvent(Event);
      end;
    cmScored:
      begin
        RollCount := 0;
        PlayerDone := (Scoreboard^.FirstThat(@Unscored) = nil);
        ScoreBoard^.SetState(sfDisabled,True);
        DiceSet^.SetState(sfDisabled,False);

        Application^.Idle; {Ensure GameOver gets updated}
        if GameOver then
        begin
          Event.What:=evCommand;
          Event.Command:=cmShowWinner;
          Application^.HandleEvent(Event);
        end;
        ClearEvent(Event);
      end;
  end; {case}
end;

function TGameWindow.RollOk;

  function DieSelected(D : PDie): boolean; far;
  begin
      DieSelected := (D^.Options and ofDie <> 0) and D^.Selected;
  end;

begin
  if RollCount in [1,2] then EnableCommands([cmSelectAll,cmDeSelectAll])
  else DisableCommands([cmSelectAll,cmDeSelectAll]);

  if GetState(sfFocused) and not GetState(sfDragging) and not PlayerDone then
  RollOk := ((DiceSet^.FirstThat(@DieSelected) <> nil) or (RollCount=0))
  else RollOk := False;
end;

{ **********  TYahWho ********** }

constructor TYahWho.Init;
var
  S : TDosStream;
  Snow : boolean;
begin
  ActivePal := DefaultPal;
  LCD := False;
  Snow := False;
  SoundOn := True;
  Awaken;
  with S do
  begin
    Init(OrigDir+ConfigName, stOpenRead);
    if Status = stOk then
    begin
      Read(ActivePal, SizeOf(ActivePal));
      Read(ScreenMode, SizeOf(ScreenMode));
      Read(Snow, SizeOf(Snow));
      Read(LCD, SizeOf(LCD));
      Read(SoundOn, SizeOf(SoundOn));
    end;
    Done;
  end;

  Inherited Init;

  CheckSnow := Snow;
  RegisterObjects;
  RegisterViews;
  RegisterMenus;
  RegisterDialogs;
  RegisterApp;
  RegisterGame;
  RegisterColorSel;
  RegisterHelpFile;
  ShowMarkers := (ScreenMode <> smCO80);
  About;
end;

constructor TYahWho.Load;
begin
  Inherited Load(S);
  Awaken;
end;

procedure TYahWho.Awaken;
{ This procedure is called from application constructors to initialize
the OrigDir variable to the home directory. Note that OrigDir must be a
global static variable. If it is a field within the TYahWho object, it
will be obliterated in the Inherited Init call.}
var
  Orig           : PathStr;
  OrigName       : NameStr;
  OrigExt        : ExtStr;
begin
  Inherited Awaken;
  if Lo(DosVersion) >= 3
      then Orig:=ParamStr(0) {DOS 3.x, can locate our origin}
  else Orig := FSearch('YAHWHO.EXE',GetEnv('PATH')); {DOS 2.x approach}
  FSplit(Orig,OrigDir,OrigName,OrigExt);
end;

destructor TYahWho.Done;
begin
  Inherited Done;
  WriteLn('Thanks for playing YahWho!');
end;

procedure TYahWho.About;
var
  D: PDialog;
  Control: PView;
  R: TRect;
  Mem : string[10];
begin
  Str(MemAvail div 1024,Mem); Mem := Mem+'K';
  R.Assign(0, 0, 40, 13);
  D := New(PDialog, Init(R, 'About'));
  with D^ do
  begin
    Options := Options or ofCentered;
    Palette := dpBlueDialog;
    R.Grow(-1, -1);
    Dec(R.B.Y, 3);
    Insert(New(PStaticText, Init(R,
      #13 +
      ^C'YahWho!'#13 +
      ^C'Version 1.0d'#13 +
      #13 +
      ^C'by Keith Greer'#13#13 +
      ^C'Memory Available: '+Mem)));

    R.Assign(15, 10, 25, 12);
    Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  end;
  ExecuteDialog(D,nil);
end;

procedure TYahWho.LoadDesktop(var S: TStream);
var
  P: PView;

procedure CloseView(P: PView); far;
begin
  if P^.Options and ofGameWindow <> 0 then PGameWindow(P)^.PlayerDone:=True;
  Message(P, evCommand, cmClose, nil);
end;

begin
  Lock;
  Desktop^.ForEach(@CloseView); { Clear the desktop }
  Unlock;
  repeat
    P := PView(S.Get);
    Desktop^.InsertBefore(ValidView(P), Desktop^.Last);
  until P = nil;
end;

procedure TYahWho.StoreDesktop(var S: TStream);

procedure WriteView(P: PView); far;
begin
  if P <> Desktop^.Last then S.Put(P);
end;

begin
  Desktop^.ForEach(@WriteView);
  S.Put(nil);
end;

function TYahWho.Valid(Command: Word): Boolean;
{ Check to see if any unfinished game windows are open.
  If so, ask if user wants to abort them before proceeding.}

  function NotDone(P : PView) : boolean; far;
  begin
    NotDone := (P^.Options and ofGameWindow <> 0) and
                (not PGameWindow(P)^.PlayerDone);
  end;

  procedure PlayersDone(P: PView); far;
  begin
    if P^.Options and ofGameWindow <> 0 then PGameWindow(P)^.PlayerDone:=True;
  end;

begin
  if (Command=cmQuit) and  (Desktop^.FirstThat(@NotDone) <> nil) then
  begin
    if (MessageBox(^C'Quit all players'' games?',nil,
        mfWarning+mfYesButton+mfNoButton) = cmYes) then
    begin
      Desktop^.ForEach(@PlayersDone); { Make all players done }
      Valid := Inherited Valid(Command);
    end else Valid := False;
  end else Valid :=Inherited Valid(Command);
end; {TYahWho.Valid}


procedure TYahWho.HandleEvent;

procedure CloseAll;

procedure CloseView(P: PView); far;
begin
  if P^.Options and ofGameWindow <> 0 then PGameWindow(P)^.PlayerDone:=True;
  Message(P, evCommand, cmClose, nil);
end;

begin
  with Desktop^ do
  begin
      Lock;
      ForEach(@CloseView); { Clear the desktop }
      Unlock;
      WinNumber := 0;
  end;
end;  {CloseAll}

procedure NewPlayer;
var
  R,Bounds : TRect;
  I : PInputLine;
  D : PDialog;
  Name : string[10];
begin
  Bounds.Assign(0,0,24,7);
  D := New(PDialog, Init(Bounds,'Player Name'));
  with D^ do
  begin
    Options := Options or ofCentered;
    Palette := dpCyanDialog;
    HelpCtx := hcDNewPlayer;

    R.Assign(2,4,10,6);
    Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));

    R.Assign(12,4,22,6);
    Insert(New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal)));

    R.Assign(5,2,17,3);
    I := New(PInputLine, Init(R,10));
    {Make the first letter of each word in caps}
    I^.SetValidator(New(PPXPictureValidator, Init('*{&*?[ ]}',False)));
    Insert(I);
  end;
  Name := '';

  if (ExecuteDialog(D,@Name) = cmCancel) or (Name = '') then exit;


  Desktop^.GetExtent(Bounds);
  InsertWindow(New(PGameWindow,Init(Bounds,Name)));

end; {NewPlayer}

procedure NewGame;
var
  Players : TStringCollection;
  Bounds  : TRect;

{ Check to see if any unfinished game windows are open.
  If so, ask if user wants to abort them before proceeding.}

  function NotDone(P : PView) : boolean; far;
  begin
    NotDone := (P^.Options and ofGameWindow <> 0) and
                (not PGameWindow(P)^.PlayerDone);
  end;

  procedure GetPlayers(P : PGameWindow); far;
  begin
    if P^.Options and ofGameWindow <> 0 then
      Players.Insert(NewStr(P^.Title^));
  end;

  procedure Player(N : PString); far;
  begin
    if (N <> nil) and (N^ <> '') then
    begin
      Inc(WinNumber);
      InsertWindow(New(PGameWindow,Init(Bounds,N^)));
    end;
  end;


begin
  if (Desktop^.FirstThat(@NotDone) <> nil) and
     (MessageBox(^C'Quit current game?',nil,
      mfWarning+mfYesButton+mfNoButton) <> cmYes) then exit;

  if (CommandEnabled(cmClose)) and (MessageBox(^C'Same Players?', nil,
     mfConfirmation+mfYesButton+mfNoButton) = cmYes) then
  begin
    Players.Init(5,5);
    Players.Duplicates := True;
    Desktop^.ForEach(@GetPlayers);
    CloseAll;
    WinNumber := 0;  {Have to handle WinNumber manually because the
                      Idle routine can't catch up}
    Desktop^.GetExtent(Bounds);
    Players.ForEach(@Player);
    Players.Done;
  end else
  begin
    CloseAll;
    NewPlayer;
  end;
end; {NewGame}

procedure ShowWinner;
var
  S : word;
  N : PString;
  Msg : string;
  SStr : string[3];
  Hall : Text;
  i,j : integer;
  Event : TEvent;
  ScoreFile,
  HOFFile   : PDosStream;
  ScoreList : PTopScoreList;
  HOFList   : PScoreList;
  NewHigh   : boolean;

  procedure GetWinner(W : PGameWindow); far;
  begin
    with W^ do if (Options and ofGameWindow <> 0) and (Total > S) then
    begin
      S := Total; N := Title;
    end;
  end;

  procedure RecordHighs(W : PGameWindow); far;
  begin
    with W^ do if (Options and ofGameWindow <> 0) and (Title^ <> '') then
    begin
      if Total > ScoreList^.MinScore then
      begin
        NewHigh := True;
        ScoreList^.Insert(New(PTopScore, Init(Total, Title^, Today)));
      end;

      if Total > HOF_Threshold then {Enter the Hall of Fame}
        HOFList^.Insert(New(PTopScore, Init(Total, Title^, Today)));
    end;
  end;

begin {ShowWinner}
  S := 0; N := nil;
  DeskTop^.ForEach(@GetWinner);
  if N<>nil then
  begin
    Str(S,SStr);
    Msg := ^C'And the winner is...'^M^C +
           N^ + ' with a score of ' + SStr;
    MessageBox(Msg,nil, mfOkButton+mfInformation);
  end;

  ScoreFile := New(PDosStream, Init(OrigDir+Top10Name,stOpen));
  if ScoreFile^.Status <> stOk then {File not found. Create it.}
  begin
    Dispose(ScoreFile,Done);
    ScoreFile := New(PDosStream, Init(OrigDir+Top10Name,stCreate));
    ScoreList := New(PTopScoreList, Init(10,0));
  end else {File was found. Read in the scores}
  ScoreList := PTopScoreList(ScoreFile^.Get);
  if ScoreFile^.Status <> stOk then
    MessageBox(^C'Score file corrupted!', nil, mfError+mfOkButton);

  HOFFile := New(PDosStream, Init(OrigDir+HOFName,stOpen));
  if HOFFile^.Status <> stOk then {File not found. Create it.}
  begin
    Dispose(HOFFile,Done);
    HOFFile := New(PDosStream, Init(OrigDir+HOFName,stCreate));
    HOFList := New(PScoreList, Init(10,5));
  end else {File was found. Read in the scores}
  HOFList := PScoreList(HOFFile^.Get);
  if HOFFile^.Status <> stOk then
    MessageBox(^C'Hall of Fame file corrupted!', nil,
                  mfError+mfOkButton);

  NewHigh := False;

  DeskTop^.ForEach(@RecordHighs);

  ScoreFile^.Seek(0);
  ScoreFile^.Put(ScoreList);
  if ScoreFile^.Status <> stOk then
    MessageBox(^C'Could not write score file!', nil, mfError+mfOkButton);

  HOFFile^.Seek(0);
  HOFFile^.Put(HOFList);
  if HOFFile^.Status <> stOk then
    MessageBox(^C'Could not write Hall of Fame file!', nil,
                   mfError+mfOkButton);

  Dispose(ScoreFile,Done);
  Dispose(HOFFile,Done);
  Dispose(ScoreList,Done);
  Dispose(HOFList,Done);

  if NewHigh then
  begin
    Tune(Top10);
    Event.What:=evCommand; Event.Command:=cmShowTop10;
    HandleEvent(Event);
  end;

end;

procedure ShowTop10;
var
  i : integer;
  R : TRect;
  D : PDialog;
  S : string[3];
  B : PView;
  ScoreFile : PDosStream;
  ScoreList : PTopScoreList;

  procedure ShowScore(TopScore : PTopScore); far;
  var
    N : string[11];
  begin
    with TopScore^ do
    begin
      Str(Score:3,S);
      N := Name;
      while Length(N) < 11 do N := N+' ';
      B:=New(PStaticText, Init(R,Date+' '+N+S));
    end;
    with B^ do Options := Options or ofCenterX;
    D^.Insert(B);
    R.Move(0,1);
  end;

begin
  ScoreFile := New(PDosStream, Init(OrigDir+Top10Name, stOpenRead));
  if ScoreFile^.Status <> stOk then
  begin
    Dispose(ScoreFile,Done);
    MessageBox(^C'Could not open score file.', nil, mfError+mfOkButton);
    exit;
  end;

  ScoreList := PTopScoreList(ScoreFile^.Get);
  if ScoreFile^.Status <> stOk then
      MessageBox(^C'Score file corrupted!', nil, mfError+mfOkButton) else
  begin
    R.Assign(0,0,33,16);
    D := New(PDialog, Init(R, 'The Top 10 Scores'));
    with D^ do
    begin
      Options := Options or ofCentered;
      Palette := dpCyanDialog;
      HelpCtx := hcDTop10;
      R.Assign(0,2,23,3);
      ScoreList^.ForEach(@ShowScore);
      Dispose(ScoreList, Done);

      GetExtent(R); R.Grow(-1,-1);
      R.A.Y:=R.B.Y-2; R.B.X := R.A.X + 8;
      B := New(PButton, Init(R,'O~K~',cmOK,bfDefault));
      with B^ do Options := Options or ofCenterX;
      Insert(B);
    end;
    ExecuteDialog(D,nil);
  end;
  Dispose(ScoreFile,Done);
end;

procedure ShowHall;
var
  R    : TRect;
  D    : PDialog;
  B    : PView;
  HOFFile  : PDosStream;
  HallList : PScoreList;
  sbPtr    : PScrollbar;

begin
  HOFFile := New(PDosStream, Init(OrigDir+'YAHWHO.HOF', stOpenRead));
  if HOFFile^.Status <> stOk then
  begin
    Dispose(HOFFile,Done);
    MessageBox(^C'Could not open Hall of Fame file.', nil,
                    mfError+mfOkButton);
    exit;
  end;

  HallList := PScoreList(HOFFile^.Get);
  if HOFFile^.Status <> stOk then
      MessageBox(^C'Hall of Fame file corrupted!', nil,
                   mfError+mfOkButton) else
  begin
    R.Assign(0,0,34,14);
    D := New(PDialog, Init(R,'The Hall of Fame'));
    with D^ do
    begin
      Options := Options or ofCentered;
      Palette := dpCyanDialog;
      HelpCtx := hcDHall;

      GetExtent(R); R.Grow(-1,-1);
      R.A.Y:=R.B.Y-2; R.B.X := R.A.X + 8;
      B := New(PButton, Init(R,'O~K~',cmOK,bfDefault));
      with B^ do Options := Options or ofCenterX;
      Insert(B);

      sbPtr := StandardScrollBar(sbVertical);
      R.Assign(4,2,29,10);
      with sbPtr^ do
      begin
        Origin.X:=29; Origin.Y:=2;
        Size.Y := 8;
      end;
      B := New(PScoreListBox, Init(R, 1, sbPtr));
      PScoreListBox(B)^.NewList(HallList);
      Insert(B);
    end;
    ExecuteDialog(D,nil);
  end;
  Dispose(HOFFile,Done);
end;

procedure ResetScores;
var
  Scores : file;
begin
  if MessageBox(^C'Are you sure you want to'^M +
                ^C'erase the scores?', nil,
                mfWarning+mfYesButton+mfNoButton) = cmYes then
  begin
    Assign(Scores,OrigDir+Top10Name); {$I-} Erase(Scores); {$I+}
    if IOresult<>0 then MessageBox(^C'Could not erase the score file.', nil,
           mfError+mfOkButton);
  end;
end;

procedure SaveDesktop;

const
  Wildcard = '*.DKG';

var
  FileName: FNameStr;
  D : PFileDialog;
  W : PView;
  S : PStream;
  F : File;
  Action : word;

begin
  FileName := Wildcard;
  D := New(PFileDialog, Init(WildCard, 'Save a Game File',
       '~N~ame', fdOkButton + fdClearButton + fdHelpButton, 100));
  if D <> nil then D^.HelpCtx := hcFOFileOpenDBox;

  case ExecuteDialog(D, @FileName) of
  cmFileOpen,cmOk :
  begin
    if Exists(FileName) and (MessageBox(^C'Overwrite '+FileName+'?', nil,
       mfWarning+mfYesButton+mfNoButton) = cmNo) then exit;
    S := New(PBufStream, Init(FileName, stCreate, 1024));
    if not LowMemory and (S^.Status = stOk) then
    begin
      StoreDesktop(S^);
      if S^.Status <> stOk then
      begin
        MessageBox('Could not create '+FileName, nil, mfOkButton + mfError);
        {$I-}
        Dispose(S, Done);
        Assign(F, FileName);
        Erase(F);
        Exit;
      end;
    end;
    Dispose(S, Done);
  end;

  cmFileClear : if MessageBox(^C'Delete '+FileName+'?', nil,
                    mfYesButton+mfNoButton+mfWarning) = cmYes then
    begin
      {$I-}
      Assign(F, FileName);
      Erase(F);
    end;
  end; {case}
end;

procedure RestoreDesktop;
const
  Wildcard = '*.DKG';

var
  FileName: FNameStr;
  D : PFileDialog;
  W : PView;
  S : PStream;
  F : File;

  function NotDone(P : PView) : boolean; far;
  begin
    NotDone := (P^.Options and ofGameWindow <> 0) and
                (not PGameWindow(P)^.PlayerDone);
  end;

begin
  if (Desktop^.FirstThat(@NotDone) <> nil) and
     (MessageBox(^C'Quit current game?',nil,
      mfWarning+mfYesButton+mfNoButton) <> cmYes) then exit;

  CloseAll;
  FileName := Wildcard;
  D := New(PFileDialog, Init(WildCard, 'Load a Game File',
       '~N~ame', fdOpenButton + fdClearButton + fdHelpButton, 100));
  if D <> nil then D^.HelpCtx := hcFOFileOpenDBox;

  case ExecuteDialog(D, @FileName) of
  cmFileOpen,cmOk :
  begin
    S := New(PBufStream, Init(FileName, stOpenRead, 1024));
    if LowMemory then OutOfMemory
    else if S^.Status <> stOk then
      MessageBox(^C'Could not open '+FileName, nil, mfOkButton + mfError)
    else
    begin
      LoadDesktop(S^);
      if S^.Status <> stOk then
        MessageBox(^C'Invalid game file format', nil, mfOkButton + mfError);
    end;
    Dispose(S, Done);
  end;

  cmFileClear : if MessageBox(^C'Delete '+FileName+'?', nil,
                    mfYesButton+mfNoButton+mfWarning) = cmYes then
    begin
      {$I-}
      Assign(F, FileName);
      Erase(F);
    end;
  end; {case}
end;

procedure Colors;
var
  D: PMyColorDialog;
begin
  D := New(PMyColorDialog, Init('', DefaultPal[AppPalette],
    ColorGroup('Desktop',       DesktopColorItems(nil),
    ColorGroup('Menus',         MenuColorItems(nil),
    ColorGroup('Std Dialogs',  DialogColorItems(dpGrayDialog, nil),
    ColorGroup('Top 10/Hall',  DialogColorItems(dpCyanDialog, nil),
    ColorGroup('About Box',    DialogColorItems(dpBlueDialog, nil),
    ColorGroup('Game Window',
      ColorItem('Frame passive',      8,
      ColorItem('Frame active',       9,
      ColorItem('Frame icons',       10,
      ColorItem('Normal Score',      11,
      ColorItem('HiLite Score',      12,
      ColorItem('Normal Dice',       13,
      ColorItem('HiLite Dice',       14, nil))))))),
    ColorGroup('Help System',
      ColorItem('Frame passive',    128,
      ColorItem('Frame active',     129,
      ColorItem('Frame icons',      130,
      ColorItem('Scroll bar page',  131,
      ColorItem('Normal Text',      133,
      ColorItem('Keyword',          134,
      ColorItem('Selected Keyword', 135, nil))))))), nil)))))))));

    D^.HelpCtx := hcOCColorsDBox;
    if ExecuteDialog(D, Application^.GetPalette) <> cmCancel then
    begin
      DoneMemory;  { Dispose all group buffers }
      ReDraw;      { Redraw application with new palette }
    end;
end;

procedure SaveConfig;
var
  S : TDosStream;
begin
  S.Init(OrigDir+ConfigName,stCreate);
  with S do
  begin
    if Status = stOk then
    begin
      Write(ActivePal, SizeOf(ActivePal));
      Write(ScreenMode, SizeOf(ScreenMode));
      Write(CheckSnow, SizeOf(CheckSnow));
      Write(LCD, SizeOf(LCD));
      Write(SoundOn, SizeOf(SoundOn));
    end;
    Done;
  end;
end;

procedure Prefs;
var
  D : PDialog;
  B : PView;
  Bounds, R : TRect;
  DlgData : record
    SnwChk   : word;
    Noises   : word;
    DMode    : word;
  end;
  OldDMode, Mode : word;

begin
  if ScreenMode<>smMono then
  begin
    Bounds.Assign(0,0,23,15);
    D := New(PDialog, Init(Bounds, 'Preferences'));
    with D^ do
    begin
      Options := Options or ofCentered;
      HelpCtx := hcOPrefs;

      R.Assign(2,8,21,9);
      B:=New(PCheckBoxes, Init(R,
        NewSItem('~S~now Checking',
        nil)));
      if HiResScreen then PCheckBoxes(B)^.Hide; {Snow checking only on CGA}
      Insert(B);

      R.Assign(2,10,21,11);
      B:=New(PCheckBoxes, Init(R,
        NewSItem('S~o~unds',
        nil)));
      Insert(B);

      R.Assign(2,12,10,14);
      Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));

      R.Assign(11,12,21,14);
      Insert(New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal)));

      R.Assign(4,3,14,6);
      B:=New(PRadioButtons, Init(R,
        NewSItem('~C~O80',
        NewSItem('~B~W80',
        NewSItem('~L~CD',
        nil)))));

      Insert(B);
      R.Assign(3,2,19,3);
      Insert(New(PLabel, Init(R,'Screen ~M~ode',B)));
    end;

    with DlgData do
    begin
      case ScreenMode of
        smCO80 : DMode := 0;
        smBW80 : if LCD then DMode := 2 else DMode := 1;
        else DlgData.DMode := 0;
      end;
      if CheckSnow then SnwChk := 1 else SnwChk := 0;
      if SoundOn then Noises:=1 else Noises:=0;
    end;

    OldDmode := DlgData.DMode;

    if ExecuteDialog(D,@DlgData) <> cmCancel then
    begin
      CheckSnow := DlgData.SnwChk=1;
      SoundOn := DlgData.Noises=1;

      case DlgData.DMode of
        0   : Mode := smCO80;
        1,2 : Mode := smBW80;
      end;
      LCD := DlgData.Dmode = 2;
    end;

    if DlgData.DMode <> OldDMode then
    begin
      Desktop^.Lock;
      SetScreenMode(Mode);
      CheckSnow := DlgData.SnwChk=1;
      ShowMarkers := (ScreenMode<>smCO80);
      DoneMemory;
      Redraw;
      Desktop^.UnLock;
    end;
  end else {Running on a Mono machine}
  begin
    Bounds.Assign(0,0,23,8);
    D := New(PDialog, Init(Bounds, 'Preferences'));
    with D^ do
    begin
      Options := Options or ofCentered;
      HelpCtx := hcOPrefs;

      R.Assign(2,2,21,3);
      B:=New(PCheckBoxes, Init(R,
        NewSItem('S~o~unds',
        nil)));
      Insert(B);

      R.Assign(2,5,10,7);
      Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));

      R.Assign(11,5,21,7);
      Insert(New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal)));
    end;
    if SoundOn then Mode := 1 else Mode := 0;
    if ExecuteDialog(D,@Mode) <> cmCancel then SoundOn := Mode=1;
  end;
end;

begin {TYahWho.HandleEvent}
  Inherited HandleEvent(Event);
  case Event.What of
    evCommand: begin
      case Event.Command of
        cmAbout      : About;
        cmNewGame    : NewGame;
        cmSaveGame   : SaveDeskTop;
        cmLoadGame   : RestoreDeskTop;
        cmNewPlayer  : NewPlayer;
        cmShowWinner : ShowWinner;
        cmShowTop10  : ShowTop10;
        cmShowHall   : ShowHall;
        cmReset      : ResetScores;
        cmColors     : Colors;
        cmSaveConfig : SaveConfig;
        cmPrefs      : Prefs;
        else Exit;
      end; {Case}
      ClearEvent(Event); {We took care of it}
    end;
  end;
end;

procedure TYahWho.GetEvent(var Event: TEvent);
var
  W: PWindow;
  HFile: PHelpFile;
  HelpStrm: PDosStream;
const
  HelpInUse: Boolean = False;
begin
  Inherited GetEvent(Event);
  case Event.What of
    evCommand:
      if (Event.Command = cmHelp) and not HelpInUse then
      begin
        HelpInUse := True;
        HelpStrm := New(PDosStream, Init(OrigDir+HelpName, stOpenRead));
        HFile := New(PHelpFile, Init(HelpStrm));
        if HelpStrm^.Status <> stOk then
        begin
          MessageBox(^C'Could not open '+OrigDir+HelpName, nil, mfError + mfOkButton);
          Dispose(HFile, Done);
        end
        else
        begin
          W := New(PHelpWindow,Init(HFile, GetHelpCtx));
          if ValidView(W) <> nil then
          begin
            ExecView(W);
            Dispose(W, Done);
          end;
          ClearEvent(Event);
        end;
        HelpInUse := False;
      end;
  end;
end;

function TYahWho.GetPalette: PPalette;
begin
  if (ScreenMode=smBW80) and LCD then AppPalette:=apMonochrome;
  GetPalette := @ActivePal[AppPalette];
end;

procedure TYahWho.Idle;
var
  NumPlayers : word;

  procedure SetWinNum(P:PGameWindow); far;
  begin
    with P^ do
      if (Options and ofGameWindow <> 0) then
      begin
        if Number > WinNumber then WinNumber := Number;
        Inc(NumPlayers);
      end;
  end;

  function GameInWork(W : PGameWindow) : boolean; far;
  begin
    with W^ do if Options and ofGameWindow <> 0 then
    GameInWork := not PlayerDone
    else GameInWork := False;
  end;


begin
  Inherited Idle;

  {Make WinNumber 1 higher than any open window number}
  WinNumber := 0; NumPlayers := 0;
  DeskTop^.ForEach(@SetWinNum);
  Inc(WinNumber);
  if NumPlayers > 1 then EnableCommands(GWinCmds) else
  DisableCommands(GWinCmds);

  if (DeskTop^.Current<>nil) and
     (DeskTop^.Current^.Options and ofGameWindow <> 0) then
  begin
    if PGameWindow(DeskTop^.Current)^.RollOk then EnableCommands([cmRollDie])
    else DisableCommands([cmRollDie]);
  end else
    DisableCommands([cmRollDie,cmSelectAll,cmDeSelectAll]);

  {Now look for an unfinished GameWindow on the Desktop to
  see if all players are done}

  GameOver := (Desktop^.FirstThat(@GameInWork)=nil);
  if GameOver then DisableCommands([cmNewPlayer]) else
  EnableCommands([cmNewPlayer]);
end;

procedure TYahWho.InitMenuBar;
var
  R: TRect;
begin
  GetExtent(R);
  R.B.Y := R.A.Y+1;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
    NewSubMenu('~'#240'~', hcMAbout, NewMenu(
      NewItem('~A~bout', '', kbNoKey, cmAbout, hcMAbout, nil)),
    NewSubMenu('~G~ame', hcGame, NewMenu(
      NewItem('~N~ew Game','', kbNoKey, cmNewGame, hcGNewGame,
      NewItem('New ~P~layer','F2', kbF2, cmNewPlayer, hcGNewPlayer,
      NewItem('~S~ave','', kbNoKey, cmSaveGame, hcGSave,
      NewItem('~L~oad','', kbNoKey, cmLoadGame, hcGLoad,
      NewItem('E~x~it','Alt-X', kbAltX, cmQuit, hcGExit, nil)))))),
    NewSubMenu('~D~ice', hcDice, NewMenu(
      NewItem('~S~elect All', 'F4', kbF4, cmSelectAll, hcDiceSel,
      NewItem('~D~eSelect All', 'Shift-F4', kbShiftF4, cmDeSelectAll,
                 hcDiceDeSel, nil))),
    NewSubMenu('~S~cores', hcScores, NewMenu(
      NewItem('~T~op 10', '', kbNoKey, cmShowTop10, hcSTop10,
      NewItem('~H~all of Fame', '', kbNoKey, cmShowHall, hcSHall,
      NewItem('~R~eset Scores', '', kbNoKey, cmReset, hcSReset, nil)))),
    NewSubMenu('~O~ptions', hcOptions, NewMenu(
      NewItem('~C~olors', '', kbNoKey, cmColors, hcOColors,
      NewItem('~P~references', '', kbNoKey, cmPrefs, hcOPrefs,
      NewItem('~S~ave Config', '', kbNoKey, cmSaveConfig, hcOConfig, nil)))),
    NewSubMenu('~W~indows', hcWindows, NewMenu(
      NewItem('~T~ile', '', kbNoKey, cmTile, hcWTile,
      NewItem('Ca~s~cade', '', kbNoKey, cmCascade, hcWCascade,
      NewItem('~M~ove/Resize', 'Ctrl-F5', kbCtrlF5, cmResize, hcWResize,
      NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcWZoom,
      NewItem('~N~ext', 'F3', kbF3, cmNext, hcWNext,
      NewItem('~P~revious', 'Shift-F3', kbShiftF3, cmPrev, hcWPrev,
      NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcWClose, nil)))))))),
            nil)))))))));
end;

procedure TYahWho.InitStatusLine;
var
  R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PMyStatusLine, Init(R,
    NewStatusDef(0, $100-1,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('~F2~ New Player', kbF2, cmNewPlayer,
      NewStatusKey('~F3~ Next Player', kbF3, cmNext,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      NewStatusKey(' ~'#17#217'~ Roll', kbEnter, cmRollDie,
      NewStatusKey('', kbF5, cmZoom,
      NewStatusKey('', kbCtrlF5, cmResize,
      NewStatusKey('', kbAltF3, cmClose, nil))))))))),
    NewStatusDef($100, $FFFF,
      NewStatusKey('~F1~ Help', kbF1, cmHelp, nil),
       nil))));
end;

function TMyStatusLine.Hint(AHelpCtx: Word): String;
begin
  case AHelpCtx of
    hcMAbout        : Hint := 'Display Program Information';
    hcGame          : Hint := 'Start New Game, Add Players...';
    hcGNewGame      : Hint := 'Begin a new game';
    hcGNewPlayer    : Hint := 'Add a new player';
    hcGSave         : Hint := 'Save game to disk';
    hcGLoad         : Hint := 'Retrieve game from disk';
    hcGExit         : Hint := 'Quit YahWho';
    hcDice          : Hint := 'Select/DeSelect All Dice';
    hcDiceSel       : Hint := 'Select all dice';
    hcDiceDeSel     : Hint := 'DeSelect all dice';
    hcScores        : Hint := 'High Scores/Hall of Fame';
    hcSTop10        : Hint := 'Display Top 10 Scores';
    hcSHall         : Hint := 'Display Hall of Fame';
    hcSReset        : Hint := 'Reset (erase) Top 10 Scores';
    hcOptions       : Hint := 'Set colors/preferences';
    hcOColors       : Hint := 'Set program colors';
    hcOPrefs        : Hint := 'Set program behaviors';
    hcOConfig       : Hint := 'Make program settings permanent';
    hcDNewPlayer    : Hint := 'Enter player name (10 chars max)';
    hcWindows       : Hint := 'Resize, move, tile, cascade windows';
    hcWTile         : Hint := 'Tile all open windows';
    hcWCascade      : Hint := 'Cascade all open windows';
    hcWResize       : Hint := 'Arrows move, Shift-arrows resize window';
    hcWZoom         : Hint := 'Toggle zoomed status';
    hcWNext         : Hint := 'Select next open window';
    hcWPrev         : Hint := 'Select previous open window';
    hcWClose        : Hint := 'Close selected window';
    hcFOFileOpenDBox : Hint := 'Specify game file to save/open';
    else Hint := '';
  end;
end;

procedure TYahWho.OutOfMemory;
begin
  MessageBox(^C'Not enough memory available to complete operation.',
    nil, mfError + mfOkButton);
end;

var
  Yah_Who : TYahWho;

begin {Main Program}
  Yah_Who.Init;
  Yah_Who.Run;
  Yah_Who.Done;
end.